PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/pleas/ole/visio/search/frmsearc.frm

Visual Basic Form | 1994-05-18 | 17.6 KB | 503 lines

VERSION 2.00
Begin Form frmSearchReplace
   BackColor       =   &H00E0FFFF&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Search / Replace"
   ClientHeight    =   4680
   ClientLeft      =   1425
   ClientTop       =   1605
   ClientWidth     =   5055
   FillColor       =   &H00E0FFFF&
   Height          =   5175
   Left            =   1320
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4680
   ScaleWidth      =   5055
   Top             =   1215
   Width           =   5265
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   495
      Left            =   2400
      TabIndex        =   18
      Top             =   3840
      Width           =   1215
   End
   Begin CommandButton cmdOK
      Caption         =   "OK"
      Height          =   495
      Left            =   3720
      TabIndex        =   17
      Top             =   3840
      Width           =   1215
   End
   Begin TextBox txtReplaceBy
      Height          =   285
      Left            =   1320
      TabIndex        =   2
      Top             =   720
      Width           =   3615
   End
   Begin TextBox txtSearchFor
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Top             =   240
      Width           =   3615
   End
   Begin Frame Frame2
      BackColor       =   &H00E0FFFF&
      Caption         =   "Fields to Change"
      Height          =   3255
      Left            =   240
      TabIndex        =   6
      Top             =   1080
      Width           =   1995
      Begin CheckBox DoSize
         BackColor       =   &H00E0FFFF&
         Caption         =   "Text Size"
         Height          =   375
         Left            =   480
         TabIndex        =   8
         Top             =   960
         Width           =   1200
      End
      Begin CheckBox DoData3
         BackColor       =   &H00E0FFFF&
         Caption         =   "Data 3"
         Height          =   375
         Left            =   480
         TabIndex        =   12
         Top             =   2760
         Width           =   1000
      End
      Begin CheckBox DoData2
         BackColor       =   &H00E0FFFF&
         Caption         =   "Data 2"
         Height          =   375
         Left            =   480
         TabIndex        =   11
         Top             =   2400
         Width           =   1000
      End
      Begin CheckBox DoData1
         BackColor       =   &H00E0FFFF&
         Caption         =   "Data 1"
         Height          =   375
         Left            =   480
         TabIndex        =   10
         Top             =   2040
         Width           =   1000
      End
      Begin CheckBox DoName
         BackColor       =   &H00E0FFFF&
         Caption         =   "Name"
         Height          =   375
         Left            =   480
         TabIndex        =   9
         Top             =   1680
         Width           =   1000
      End
      Begin CheckBox DoText
         BackColor       =   &H00E0FFFF&
         Caption         =   "Text"
         Height          =   375
         Left            =   480
         TabIndex        =   7
         Top             =   600
         Value           =   1  'Checked
         Width           =   1200
      End
      Begin Label Label2
         BackColor       =   &H00E0FFFF&
         Caption         =   "The Text"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   360
         Width           =   1200
      End
      Begin Label Label1
         BackColor       =   &H00E0FFFF&
         Caption         =   "Special Fields"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   1440
         Width           =   1500
      End
   End
   Begin Frame Frame1
      BackColor       =   &H00E0FFFF&
      Caption         =   "Scope of Search"
      Height          =   1575
      Left            =   2640
      TabIndex        =   0
      Top             =   1200
      Width           =   1995
      Begin OptionButton optScope
         BackColor       =   &H00E0FFFF&
         Caption         =   "All Pages"
         Height          =   375
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Top             =   1080
         Width           =   1455
      End
      Begin OptionButton optScope
         BackColor       =   &H00E0FFFF&
         Caption         =   "Current Page"
         Height          =   375
         Index           =   1
         Left            =   240
         TabIndex        =   4
         Top             =   720
         Width           =   1455
      End
      Begin OptionButton optScope
         BackColor       =   &H00E0FFFF&
         Caption         =   "Selection"
         Enabled         =   0   'False
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Width           =   1335
      End
   End
   Begin Label lblPassiveHelp
      BackColor       =   &H00FFC0C0&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   0
      TabIndex        =   20
      Top             =   4440
      Width           =   5055
   End
   Begin Label Label5
      Caption         =   "     Search/Replace for Visio.                           Version 1.1                                   Copyright (c) 1993                     by Dennis K. Fitzgerald"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   855
      Left            =   2640
      TabIndex        =   19
      Top             =   2880
      Width           =   1935
      WordWrap        =   -1  'True
   End
   Begin Label Label4
      BackColor       =   &H00E0FFFF&
      Caption         =   "Replace By:"
      Height          =   285
      Left            =   240
      TabIndex        =   16
      Top             =   720
      Width           =   1095
   End
   Begin Label Label3
      BackColor       =   &H00E0FFFF&
      Caption         =   "Search For:"
      Height          =   285
      Left            =   240
      TabIndex        =   15
      Top             =   240
      Width           =   1095
   End
Sub cmdCancel_Click ()
  End                   'Close everything and go home
End Sub
Sub cmdCancel_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Click to cancel and return to Visio."
End Sub
Sub cmdOK_Click ()
'   Make sure there is something to search for
  If txtSearchFor = "" Then
    Beep
    MsgBox "You must specify ""Search For:"" text.", 48, "Visio Search/Replace"
    txtSearchFor.SetFocus
    Exit Sub
  End If
'   Make sure a Field to Change has been specified
  If DoText + DoSize + DoName + DoData1 + DoData2 + DoData3 = 0 Then
    Beep
    MsgBox "You must select one or more Fields to Change.", 48, "Visio Search/Replace"
    DoText.SetFocus
    Exit Sub
  End If
'   When changing size, check for valid replace-by
  If DoSize Then
    If Val(txtReplaceBy) <= 0 Then
      Beep
      MsgBox ("When changing size, Replace By must be numeric and greater than zero.")
      txtReplaceBy.SetFocus
      Exit Sub
    End If
  End If
'   Start the search
  Select Case ScopeSelection
  Case 0    'Selection
    frmConfirm!lblSearching = "Selection"
    DoSearch SelList
  Case 1    'Current Page
    Set Curpage = appVisio.ActivePage
    If Curpage Is Nothing Then
      Beep
      MsgBox "There is no current page.", 16, "Visio Search/Replace"
      End
    End If
    Debug.Print "Processing current page named "; Curpage.Name
    Set ShapeList = Curpage.Shapes
    frmConfirm!lblSearching = "Page: " & Curpage.Name
    DoSearch ShapeList
  Case 2    'All pages
    Set PageList = doc.Pages
    npages = PageList.Count
    If npages = 0 Then
      Beep
      MsgBox "There are no pages.", 16, "Visio Search/Replace"
      End
    End If
    For i = 1 To npages
      Set Curpage = PageList(i)
      Debug.Print "Processing page "; i; " named "; Curpage.Name
      Set ShapeList = Curpage.Shapes
      frmConfirm!lblSearching = "Page: " & Curpage.Name
      DoSearch ShapeList
    Next i
  End Select
End Sub
Sub cmdOK_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Click to start Search/Replace."
End Sub
Sub DoData1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Data1 field."
End Sub
Sub DoData2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Data2 field."
End Sub
Sub DoData3_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Data3 field."
End Sub
Sub DoName_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Name field."
End Sub
Sub DoSearch (ShapeList As Object)
'   This is the guts of Visio Search Replace
'   DoSearch does the actual search and replace using
'   ShapeList as the collection of shapes to process.
'----------------------------------------------------------
'   Initialize FindMode to srSkip so Confirmation Form
'   will be called on first match.
  FindMode = srSkip
'   Loop through shapes in ShapeList
  nshapes = ShapeList.Count
  Debug.Print "DoSearch called.  nshapes="; nshapes
  If nshapes > 0 Then
    For i = 1 To nshapes
      Set CurShape = ShapeList.Item(i)          'Get next shape
      frmConfirm!lblInShape = CurShape.Name     'Fill in shape name in Confirmation form
      Debug.Print "Found shape "; CurShape.Name
'   Process Text Field
      If DoText Then                      'Is text field specified?
        Debug.Print "Processing Text: "; CurShape.Text
        ii = InStr(1, CurShape.Text, txtSearchFor)  'search for text
        If ii <> 0 Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Text"
            frmConfirm!lblFoundTxt = CurShape.Text
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            newstr$ = Mid$(CurShape.Text, 1, ii - 1) & txtReplaceBy & Mid$(CurShape.Text, ii + Len(txtSearchFor))
            Debug.Print "Newstr="; newstr$
            CurShape.Text = newstr$
          End If
        End If
      End If
      If DoSize Then
        Set CurCell = CurShape.CellsSRC(visSectionCharacter, visRowCharacter, visCharacterSize)
        CurSize = CurCell.Result(visPoints)
        Debug.Print "Processing Size: "; CurSize
        If CurSize = Val(txtSearchFor) Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Text Size in Points"
            frmConfirm!lblFoundTxt = CurSize
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            If Val(txtReplaceBy) > 0 Then
              CurCell.Result(visPoints) = Val(txtReplaceBy)
            End If
          End If
        End If
      End If
'   Process Name Field
      If DoName Then                      'Is Name field specified?
        Debug.Print "Processing Name: "; CurShape.Name
        ii = InStr(1, CurShape.Name, txtSearchFor)  'search for text
        If ii <> 0 Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Name"
            frmConfirm!lblFoundTxt = CurShape.Name
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            newstr$ = Mid$(CurShape.Name, 1, ii - 1) & txtReplaceBy & Mid$(CurShape.Name, ii + Len(txtSearchFor))
            Debug.Print "Newstr="; newstr$
            CurShape.Name = newstr$
          End If
        End If
      End If
'   Process Data1 field
      If DoData1 Then
        Debug.Print "Processing Data1: "; CurShape.Data1
        ii = InStr(1, CurShape.Data1, txtSearchFor)
        If ii <> 0 Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Data1"
            frmConfirm!lblFoundTxt = CurShape.Data1
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            newstr$ = Mid$(CurShape.Data1, 1, ii - 1) & txtReplaceBy & Mid$(CurShape.Data1, ii + Len(txtSearchFor))
            Debug.Print "Newstr="; newstr$
            CurShape.Data1 = newstr$
          End If
        End If
      End If
'   Process Data2 field
      If DoData2 Then
        Debug.Print "Processing Data2: "; CurShape.Data2
        ii = InStr(1, CurShape.Data2, txtSearchFor)
        If ii <> 0 Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Data2"
            frmConfirm!lblFoundTxt = CurShape.Data2
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            newstr$ = Mid$(CurShape.Data2, 1, ii - 1) & txtReplaceBy & Mid$(CurShape.Data2, ii + Len(txtSearchFor))
            Debug.Print "Newstr="; newstr$
            CurShape.Data2 = newstr$
          End If
        End If
      End If
'   Process Data3 field
      If DoData3 Then
        Debug.Print "Processing Data3: "; CurShape.Data3
        ii = InStr(1, CurShape.Data3, txtSearchFor)
        If ii <> 0 Then  'found
          If FindMode <> srDoAll Then
            frmConfirm!lblInField = "Data3"
            frmConfirm!lblFoundTxt = CurShape.Data3
            frmConfirm.Show 1
          End If
          If FindMode <> srSkip Then
            newstr$ = Mid$(CurShape.Data3, 1, ii - 1) & txtReplaceBy & Mid$(CurShape.Data3, ii + Len(txtSearchFor))
            Debug.Print "Newstr="; newstr$
            CurShape.Data3 = newstr$
          End If
        End If
      End If
    Next i
  End If
End Sub
Sub DoSize_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Character Size field."
End Sub
Sub DoText_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select (X) to search and replace in Text field."
End Sub
Sub Form_Load ()
'   Link up with Visio application, if any
  On Error GoTo NoVisio                           ' Don't blow up if no Visio
  Set appVisio = GetObject(, "visio.application") ' Get Visio instance
  On Error GoTo 0                                 ' OK to blow up, now.
'   Get current document
  If appVisio.Documents.Count > 0 Then
    Set doc = appVisio.ActiveDocument
    Debug.Print "Current Document is "; doc.Name
  Else
    Beep
    MsgBox "There are no open Visio documents.", 16, "Visio Search/Replace"
    End
  End If
'   Get current window and check to see if there is a selection
  Set CurWin = appVisio.ActiveWindow
  If CurWin Is Nothing Or CurWin.Type <> visDrawing Then
    Beep
    MsgBox "There is no active Visio drawing window.", 16, "Visio Search/Replace"
    End
  End If
  Set SelList = CurWin.Selection
  SelCount = SelList.Count
  If SelCount = 0 Then
    optScope(0).Enabled = False
    optScope(1).Value = True   'Default to Current Page
  Else
    optScope(0).Enabled = True
    optScope(0).Value = True  'Default to Selection
  End If
Exit Sub
'   Come here when we get error accessing Visio
NoVisio:
  Beep
  MsgBox "Visio is not active", 16, "Visio Search/Replace"
  End
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub Frame1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select which collection of shapes to process."
End Sub
Sub Frame2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select field(s) to search."
End Sub
Sub HelpOff ()
  lblPassiveHelp = ""
End Sub
Sub HelpOn (t)
   lblPassiveHelp = t
End Sub
Sub Label1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub Label2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub Label3_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub Label4_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub Label5_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Hope you enjoy using Visio Search/Replace!"
End Sub
Sub lblPassiveHelp_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOff
End Sub
Sub optScope_Click (Index As Integer)
  Debug.Print "optScope.click called with Index="; Index
  ScopeSelection = Index
End Sub
Sub optScope_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Select which collection of shapes to process."
End Sub
Sub txtReplaceBy_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Enter replacement text."
End Sub
Sub txtSearchFor_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  HelpOn "Enter text to search for."
End Sub